@L|}6CD l0C)HCC WhL/h `CmCDiD`  R@W1  Y0@R !L` D  C D     )16CS S)  C)D1 p p 0 C9DI pCDL~CiCDiD` D  C D     )16CS S)  C)D1 p p }0 C9DI pCDL~CiCDiD` DD˙` d J)L !}D L(( LL()  L| L( S LH 0p n  } CY?  q  L L  ` )} `A! d߰")-݆ "  $G@LLL&0") $G% }H0 3S8`G ȱG ȱG   Gȭ Gȭ GG}GHiH8(()) G$H% `(0 })8` d)L ݆ & LGȘ ݆LL d  ! LL d)N>Q  HH) }  hyhyB q L> Lm JJ  Ln*` dB%' }8  H H` 1 { LL   !L     Hh SY?  q  1L }  !? S   q 1 L   Ll  Lg E`L   !L)  q 1L}) `L0AM݊L݉ ML  N݆LLLNLMLHG!@}1F GȱGLLEEȩÑEȑEEȑE Ed E7EȩE  q} L !,0,0SGɛ L 1 !L EHEh W G gLLSROTCES EERF } G) *Gȩ GȽG GȌd q q G`  8   0G  `D}CEDC0X:Ȣ Y ȱC* ? 0.. , 0%n ?A[ 0 : L`L  `, 0`Y}`piH n0)բY? 08`0 }  0$L GGȽG L `8L`L}8`  05G)݁,G)ȱGȱGHh0})Hh` B! 8`8iiiLE`}E8FEh( l0`ɃLL L8^~jj8jHi hEEEiEȱEiE` dTE} H8EEȱEEȩEh J E8   . m  i`LI!)E1FR}1LJ舩9GIH`LJJ`HGHh l`} S gL   8 rii `дCDCG W  }C  Lq` X٨`DOS SYS IIIIIIIIIIIIIIIC`0 ߩ0}}} HE |||DDOS DOSDOS SYS }}}}CDOS SYS} 0`BDELV !B }`LVUQ   ]   TU J ]L!T  #      TU  } L ? .  t`GBJ V~DEHI B V0dV!}QDEHI VF9 ,0 ,0 s0hhL  L` H hDHEh"}DEL8HI   0 HI,0 0  9 .G VLO#},0 L4*IJ`llD1:AUTORUN.SYSNEED MEM.SAV TO LOAD THIS FILE.D1:MEM.SAV J y08 B|DEHI$} V0 0`B;DELV䌚 !B y`@ʆ v s? F0Ξ05: [ BDEHI%} VY8 B V  @  /DE `E:D1:DUP.SYSERROR-SAVING USER MEMORY ON DISKTYPE Y TO &}STILL RUN DOS B;DE J V (` 9 V⪍ ઍ  -'}LLu DEHILV 9 .l 9 .l  `` s$B VBH(}I|DE V BLV nB,DE J V* \*` B V BLVDEHI BLVL)}1u H232435; 1 ;  hh@2 e1i1LHҍ 00) 08 109hh@ Ҡ2e*}1i1232435ޥ<<8 } 3E:}DISK OPERATING SYSTEM II VERSION 2.0SCOPYRIGHT 1980 ATARIA. DISK DIRECTORY I. FORMAT DISKB. RUN CARTRIDGE J. D,}UPLICATE DISKC. COPY FILE K. BINARY SAVED. DELETE FILE(S) L. BINARY LOADE. RENAME FILE M. RUN AT ADDRESSF. LOCK F-}ILE N. CREATE MEM.SAVG. UNLOCK FILE O. DUPLICATE FILEH. WRITE DOS FILES9!&x#!7&p))'&X*./)L''-؆莟.}R'S  vW DEHHI 1A#! @ ~0ɛ8A0.) ȅ 1 1i/}il ! 1L NO SUCH ITEMSELECT ITEM OR FOR MENU! 0 .{z:*{}.|~ 1 0 00}JB 18L^%|DLl%DIRECTORY--SEARCH SPEC,LIST FILE? # 0 0 n&|D! 1L NOT A DISK FILE1}N !B 1L " 1 !BDED:}:1BJ|DE 1DEBH2}I 1 h0ߢ 0.  0?詛 1 ~0YЛ 1 "L<" "L 3} BL1TYPE "Y" TO DELETE...DELETE FILE SPECCOPY--FROM, TO?OPTION NOT ALLOWED COPYING---DN:4}# 0|D .L$A#B#C#JB|DE 1BHIDD#E 1D#0: B5} 1L B#C#C#B# B 1N#$0SYS1}:e#D# d# D# .d#ȽD# d# 𩛙d#X# 1,A#6}PdD#ELO- A.BJdD#E 1 1HH 0hh|DL^%1}:e# Lt% e#dD#EL%7} 1 0 . .0% 1L WILD CARDS NOT ALLOWED IN DESTINATION 0 A.|K@C}//3Hu ξL/L DRIVE TO WRITE DOS FILES TO?WRITING NEW DOS FILESTYPE "Y" TO WRITE DOS TO DRIVE 1.?}D1:DOS.SYSERROR - NOT VERSION 2 FORMAT. , &* բ( 1L `[) 0NΞ 0 L1M) 1@} L BAD LOAD FILELOAD FROM WHAT FILE?) 0 0#B 1L WHAT FILE TO LOCK?) 0 0$B 1L WHAT FILE TO UNLOCK?DUA}P DISK-SOURCE,DEST DRIVES?TYPE "Y" IF OK TO USE PROGRAM AREACAUTION: A "Y" INVALIDATES MEM.SAV. h  ,B}  `)  <0 2 2 0  ,   ,,ޢ* 1L ,K* 1 ~0 0C}FINSERT BOTH DISKS, TYPE RETURNERROR - DRIVES INCOMPATIBLE., 1 ~038  , 1L D}, &*  Lz+, 0 , 1 ~0 + Y,0!,0 ,L+ ,mm  v,"ǭE}0Ξ, 05,Lt+L +,Hh` NOT ENOUGH ROOMINSERT SOURCE DISK,TYPE RETURNF}INSERT DESTINATION DISK,TYPE RETURN`    `L,8,0( rG}L1(`ߢ) 1* 1 ~0Y`hhL S SL1) 8`NAME OF FILE TO MOVE?- 0 0|DLtH}% A., 1 <0 0 .@L# .BJ 1  DEHIB V L1 ,5 1 <0,L. I} JB|,A#Pd#DE 1 HI BDEHHII 1 B 1 , 1 <0,0Lf- B VJ},A#P, 1 <0 0L#L ߢ) 1* 1 ~0Yj383}mm ݭK}}`8}``|* ? ɛ,`|:(|/ 1L `DESTINATION CANT L}BE DOS.SYS0 0H{ $22Δ $28/L /) $2 Π $2 0 ξM}hAΞB,0 J 1 BޝDEHI,HDE 1HIHIDELSAVE-N}GIVE FILE,START,END(,INIT,RUN)O X0 1`BDEPHI V` X0H 1 L O}0 0 1L0`PLEASE TYPE 1 LETTER,0`hhL <0 1L0LA1 ,;ɛ7,"ɛ:ݦ1ݥP}A"D|ݤD|ȩ:|ȩ|ɛ,,(/+.ީ1 1,ɛ`轤{Q}NAME TOO LONG B VL ` L1I H1EӝDL1|mDiE` V0`8d/8 i:"2!22 1R} L ERROR- 138ɛ+,' 20*.. өw2 1``2TOO MANY DIGITSINVALIDS} HEXADECIMAL PARAMETER800 0 8 00`,0'D800H,ɛh`2L1NEED D1 THRU D4uT} HEXADECIMAL PARAMETER800 0 8 00`,0'D800H,ɛh`2L1NEED D1 THRU D4u#include "ccg"/* start of cc7 */hie11(lval)int *lval;$(int k;char *ptr;k=primary(lval);ptr=lval[0];blanks();iV}f((ch()=='[')|(ch()=='('))while(1)$(if(match("["))$(if(ptr==0)$(error("can't subscript");junk();needbW}rack("]");return 0;$)else if(ptr[ident]==pointer)rvalue(lval);else if(ptr[ident]!=array)$(error("cX}an't subscript");k=0;$)push();expression();needbrack("]");if(ptr[type]==cint)doublereg();add();Y}/* not in sym tab & not pointeror array */lval[0]=lval[2]=0;lval[1]=ptr[type];k=1;$)else if(match("Z}("))$(if(ptr==0)callfunction(0);else if(ptr[ident]!=function)$(rvalue(lval);callfunction(0);$)else [}callfunction(ptr);k=lval[0]=0;$)else return k;$)if(ptr==0)return k;if(ptr[ident]==function)$(immed();ou\}tlab(ptr);return 0;$)return k;$)primary(lval)int *lval;$(char *ptr,sname[namesize];int num[1];int k;lval]}[2]=0; /* clear pointer/array type */if(match("("))$(k=hie1(lval);while(match(","))/* comma op */k=hie1(lval);^}needbrack(")");return k;$)if(symname(sname))$(if(ptr=findloc(sname))$(getloc(ptr);lval[0]=ptr;lval[1]=_}ptr[type];if(ptr[ident]==pointer)$(lval[1]=cint;lval[2]=ptr[type];$)if(ptr[ident]==array)$(lval[2]`}=ptr[type];return 0;$)else return 1;$)if(ptr=findglb(sname))if(ptr[ident]!=function)$(lval[0]=ptra};lval[1]=0;if(ptr[ident]!=array)$(if(ptr[ident]==pointer)lval[2]=ptr[type];return 1;$)b}immed();outlab(ptr);lval[1]=lval[2]=ptr[type];return 0;$)ptr=addglb(sname,function,cint,0,global);lvc}al[0]=ptr;lval[1]=0;return 0;$)if(constant(num))return(lval[0]=lval[1]=0);else$(error("invalid expression")d};immed();outdec(0);junk();return 0;$)$)/* * true if val1 -> int pointer * or int array and * val2 not ptr or e}array */dbltest(val1,val2)int val1[],val2[];$(if(val1[2]!=cint)return 0;if(val2[2])return 0;return 1;$)/* * def}termine type of binary operation */result(lval,lval2)int lval[],lval2[];$(if(lval[2] & lval2[2]) /* both point or arrag}y */lval[2]=0;else if(lval2[2])$(lval[0]=lval2[0];lval[1]=lval2[1];lval[2]=lval2[2];$)$)store(lval)int *h}lval;$(if (lval[1]==0)putmem(lval[0]);else putstk(lval[1]);$)rvalue(lval)int *lval;$(if ((lval[0]!=0) & (lval[1]=i}=0))getmem(lval[0]);else indirect(lval[1]);$)test(label)int label;$(needbrack("(");expression();needbrack(")j}");falsejump(label);$)constant(val)int val[];$(if (number(val))$(immed();outdec(val[0]);$)else if (pstr(val))k}$(immed();outdec(val[0]);$)else if (qstr(val))$(immed();outslt(val[0]);$)else return 0;return 1;$)number(val)il}nt val[];$(int k,minus,base;char c;k=minus=1;base=10;/* start with base 10 */while(k)$(k=0;if(match("+"))k=m}1;if(match("-"))$(minus=(-minus);k=1;$)$)if(numeric(ch())==0)return 0;if(ch()=='0')$(gch(); /* gobblen} 0 */c=ch(); /* examine next char */if(c=='x' | c=='X')$(base=16;gch(); /* gobble "x" */$)else base=8;$o})while(1)$(c=ch();if(numeric(c))k=k*base+(c-'0');else if(base==16)$(if(c>='A' & c <='F')c=c-55;else ip}f(c>='a' & c <='f')c=c-87;else break; /* not hex */k=k*base+c;$)else break; /* not diget */inbyte(); /* gobbq}le char */$)if (minus<0) k=(-k);val[0]=k;return 1;$)pstr(val)int val[];$(int k;char c;k=0;if (match("'")=r}=0) return 0;while((c=gch())!=39 & c!=0)k=((k&255)<<8) + parsech(c);val[0]=k;return 1;$)qstr(val)int val[];$(s}if(match(quote)==0) return 0;val[0]=litptr;while (ch()!='"')$(if(ch()==0)break;if(litptr>=litmax)$(error("strit}ng space exhausted");while(match(quote)==0)if(gch()==0)break;return 1;$)litq[litptr++]=parsech(gch());$)u}gch();litq[litptr++]=0;return 1;$)/* Parse a character. * converts \n into EOL, etc. */parsech(chr)char chr;$(v}int oct,i;char c;/* pass through unless backslash */if(chr != 92)return chr;c=ch();if(c=='b')c=126; /* backspace w}*/else if(c==34)c=34; /* " */else if(c==39)c=39; /* apostrophe */else if(c=='f')c=125; /* CLEAR */else if(c=='n')c=15x}5; /* EOL */else if(c=='g')c=253; /* Bell */else if(c=='t')c=127; /* TAB */else if(c==92)c=92; /* backslash */else ify}(c >='0' & c <= '7')$(/* octal (yuk) constant */oct=c-'0';gch();i=1;while(i<=2)$(c=ch();if(c < '0' | cz} > '7')break;oct=(oct<<3)+c-'0';gch();++i;$)return oct;$)else c=ch(); /* ignore \ */gch(); /* skip co{}de char */return c;$)/* end of cc7 */l)int *lval;$(int k;char *ptr;k=primary(lval);ptr=lval[0];blanks();i,#include "ccg"/* start of cc8 *//* start native assembly language */usr(adr)int adr;$(outbyte(0);outdec(adr);$)/* }} Fetch a static memory cell into the primary register */getmem(sym)char *sym;$(if((sym[ident]!=pointer)&(sym[type]==cch ~}ar))outbyte(1);else outbyte(2);outlab(sym);$)/* Fetch the address of the specified symbol *//* into the primary r }egister */getloc(sym)char *sym;$(outbyte(3);outdec((255&sym[offset])+((255&sym[offset+1])<<8)-oursp);$)/* Store th }e primary register into the specified *//* static memory cell */putmem(sym)char *sym;$(if((sym[ident]!=pointer)&(sym[t }ype]==cchar))outbyte(4);else outbyte(5);outlab(sym+name);$)/* Store the specified object type in the primary regist }er *//* at the address on the top of the stack */putstk(typeobj)char typeobj;$(if(typeobj==cchar)outbyte(6);else ou }tbyte(7);popsp();$)/* Fetch the specified object type indirect through the *//* primary register into the primary regis }ter */indirect(typeobj)char typeobj;$(if(typeobj==cchar)outbyte(8);else outbyte(9);$)/* Swap the primary and secon }dary registers */swap()$(outbyte(10);$)/* Print partial instruction to get an immediate value *//* into the primary re }gister */immed()$(outbyte(11);$)/* Push the primary register onto the stack */push()$(outbyte(12);pushsp();$) }/* Swap the primary register and the top of the stack */swapstk()$(outbyte(14);$)/* Call the specified subroutine name }*/call(sname,narg)char *sname;int narg;$(outbyte(15);outlab(sname);outcch(narg+2); /* narg=2*# args */oursp=our }sp-narg;$)/* Return from subroutine */ret()$(outbyte(16);$)/* Perform subroutine call to value on top of stack */cal }lstk(narg)int narg;$(outbyte(17);outcch(narg+2);oursp=oursp-narg;popsp();$)/* Jump to specified internal label }number */jump(label)int label;$(outbyte(18);outclb(label);$)/* * truejump -- jump to lable if p nz */truejump }(label)int label;$(outbyte(13);outclb(label);$)/* * falsejump -- jump to lable if p z */falsejump(label)int la }bel;$(outbyte(19);outclb(label);$)/* cmpjump -- compare p to constant * and jump not-equal to label */cmpjump(con }stant,label)int constant,label;$(outbyte(46);outdec(constant);outclb(label);$)/* Modify the stack pointer to the }* new value indicated */modstk(newsp)int newsp; $(int k;k=newsp-oursp;if(k!=0)$(outbyte(20);outdec(k);$)r }eturn newsp;$)/* Double the primary register */doublereg()$(outbyte(21);$)/* Add the primary and secondary registers }*//* (results in primary) */add()$(outbyte(22);popsp();$)/* Subtract the primary register from the secondary *//* ( }results in primary) */sub()$(outbyte(23);popsp();$)/* Multiply the primary and secondary registers *//* (results in }primary */mult()$(outbyte(24);popsp();$)/* Divide the secondary register by the primary *//* (quotient in primary, r }emainder in secondary) */div()$(outbyte(25);popsp();$)/* Compute remainder (mod) of secondary register divided *//* }by the primary *//* (remainder in primary, quotient in secondary) */mod()$(outbyte(26);popsp();$)/* Inclusive 'or' }the primary and the secondary registers *//* (results in primary) */or()$(outbyte(27);popsp();$)/* Exclusive 'or' the } primary and seconday registers *//* (results in primary) */xor()$(outbyte(28);popsp();$)/* 'And' the primary and sec }ondary registers *//* (results in primary) */and()$(outbyte(29);popsp();$)/* Arithmetic shift right the secondary reg }ister number of *//* times in primary (results in primary) */asr()$(outbyte(30);popsp();$)/* Arithmetic left shift th }e secondary register number of *//* times in primary (results in primary) */asl()$(outbyte(31);popsp();$)/* Form two' }s complement of primary register */neg()$(outbyte(32);$)/* Form one's complement of primary register */com()$(outbyte( }33);$)/* Increment the primary register by one */inc()$(outbyte(34);$)/* Decrement the primary register by one */dec() }$(outbyte(35);$)/* Following are the conditional operators *//* They compare the secondary register against the primary * }//* and put a literal 1 in the primary if the condition is *//* true, otherwise they clear the primary register *//* Test } for equal */eq()$(outbyte(36);popsp();$)/* Test for not equal */ne()$(outbyte(37);popsp();$)/* Test for less t }han (signed) */lt()$(outbyte(38);popsp();$)/* Test for less than or equal to (signed) */le()$(outbyte(39);popsp() };$)/* Test for greater than (signed) */gt()$(outbyte(40);popsp();$)/* Test for greater than or equal to (signed) */ }ge()$(outbyte(41);popsp();$)/* Test for less than (unsigned) */ult()$(outbyte(42);popsp();$)/* Test for less tha }n or equal to (unsigned) */ule()$(outbyte(43);popsp();$)/* Test for greater than (unsigned) */ugt()$(outbyte(44); }popsp();$)/* Test for greater than or equal to (unsigned) */uge()$(outbyte(45);popsp();$)outdec(numbr)int numbr; }$(outbyte(131); /* 16 bit const */outbyte(numbr&255);outbyte((numbr>>8)&255);$)outcch(numbr)int numbr;$(outbyte }(130); /* 8 bit const */outbyte(numbr&255);$)outlab(n) char *n;$(outclb(adtoi(n));$)outclb(sym)int sym;$(outbyte(12 }8);outbyte(sym&255);outbyte((sym>>8)&255);$)outldf(n) char *n;$(outcdf(adtoi(n));$)outcdf(sym)int sym;$(outbyte( }129);outbyte(sym&255);outbyte((sym>>8)&255);$)outdat(n)int n;$(outbyte(132);outbyte(n&255);outbyte((n>>8)&255) };$)outslt(n)int n;$(outbyte(133);outbyte(n&255);outbyte((n>>8)&255);$)outsp(n)int n;$(outbyte(134);outbyt }e(n&255);outbyte((n>>8)&255);$)/* out a global or external name */outgoe(code,sname)char code,*sname;$(int adr; }adr=adtoi(sname);outbyte(code);outbyte(adr&255);outbyte((adr>>8)&255);while(*sname)outbyte(*sname++);outbyte(0);$) }adtoi(p)char *p;$(return (p-symtab)/symsiz+10000; /* offset */$)popsp()$(return oursp=oursp-2;$)pushsp()$(return }oursp=oursp+2;$)/* End of cc8 *//* start native assembly language */usr(adr)int adr;$(outbyte(0);outdec(adr);$)/* #@( rt native assembly language */usr(adr)int adr;$(outbyte(0);outdec(adr);$)/**#include "CCG"/*>>>>> start of cc3 <<<<<<<<<*//* Perform a function call * called from hie11, this routine * will eith}er call * the named function, or if the * supplied ptr is * zero, will call the contents of HL */callfunction(ptr)cha}r *ptr;/* symbol table entry (or 0) */$(int nargs;nargs=0;blanks();/* already saw open paren */if(ptr==0)push();/*} calling HL */while(streq(line+lptr,")")==0)$(if(endst())break;fexpress();/* get an argument */if(ptr==0)swapstk(}); /* don't push addr */push();/* push argument */nargs=nargs+2;/* count args*2 */if (match(",")==0) break;$)}needbrack(")");if(ptr)call(ptr,nargs);else callstk(nargs);$)junk()$(if(an(inbyte()))while(an(ch()))gch();else w}hile(an(ch())==0)$(if(ch()==0)break;gch();$)blanks();$)endst()$(blanks();return ((streq(line+lptr,";")|(ch()}==0)));$)illname()$(error("illegal symbol name");junk();$)multidef(sname)char *sname;$(error("already defined");pl}(sname);putchar(eol);$)needbrack(str)char *str;$(if (match(str)==0)$(error("missing bracket");pl(str);putchar(eol});$)$)needlval()$(error("must be lvalue");$)findglb(sname)char *sname;$(char *ptr;ptr=startglb;while(ptr!=gl}bptr)$(if(astreq(sname,ptr,namemax))return ptr;ptr=ptr+symsiz;$)return 0;$)findloc(sname)char *sname;$(char }*ptr;ptr=startloc;while(ptr!=locptr)$(if(astreq(sname,ptr,namemax))return ptr;ptr=ptr+symsiz;$)return 0;$)ad}dglb(sname,id,typ,value,sclass)char *sname,id,typ;int value,sclass;$(char *ptr;if(cptr=findglb(sname))return cptr;i}f(glbptr>=endglb)$(error("global symbol table overflow");return 0;$)cptr=ptr=glbptr;while(an(*ptr++ = *sname++))};/* copy name */cptr[ident]=id;cptr[type]=typ;cptr[storage]=sclass;cptr[offset]=value;cptr[offset+1]=value>>8;gl}bptr=glbptr+symsiz;return cptr;$)addloc(sname,id,typ,value)char *sname,id,typ;int value;$(char *ptr;if(cptr=findl}oc(sname))return cptr;if(locptr>=endloc)$(error("local symbol table overflow");return 0;$)cptr=ptr=locptr;whil}e(an(*ptr++ = *sname++));/* copy name */cptr[ident]=id;cptr[type]=typ;cptr[storage]=stkloc;cptr[offset]=value;cptr}[offset+1]=value>>8;locptr=locptr+symsiz;return cptr;$)/* Test if next input string is legal symbol name */symname(sna}me)char *sname;$(int k;blanks();if(alpha(ch())==0)return 0;k=0;while(an(ch()))sname[k++]=gch();sname[k]=0;ret}urn 1;$)/* Return next avail internal label number */getlabel()$(return(++nxtlab);$)/* Test if given character is al}pha */alpha(c)char c;$(return(((c>='a')&(c<='z'))|((c>='A')&(c<='Z'))|(c=='_'));$)/* Test if given character is} numeric */numeric(c)char c;$(return((c>='0')&(c<='9'));$)/* Test if given character is alphanumeric */an(c)char c};$(return((alpha(c))|(numeric(c)));$)/* Print a carriage return and a string only to console */pl(str)char *str;$(in}t k;k=0;putchar(eol);while(str[k])putchar(str[k++]);$)addwhile(ptr)int ptr[]; $(int k;if (wqptr==wqmax)$(er}ror("too many active whiles");return;$)k=0;while (k0)$(if((k==eol)|(lptr>=linemax))break;line[lptr++]=k;$)line[lptr]=0;/* append null */if(}k<=0)$(cclose(unit);if(inp2)inp2=0;else inp=0;$)if(lptr)$(lptr=0;return;$)$)$)l eithw#include "ccg"/*>>>>> start cc1 <<<<<<*//* Compiler begins execution here * inp is input fd, * output is output fd *} (called multiple times from main) */compile()$(glbptr=startglb;/* clear globl symbols */locptr=startloc;/* clear l}ocal symbols */wqptr=wq;/* clear while queue */macptr=/* clear the macro pool */litptr=/* clear literal pool */} oursp=/* stack ptr (relative) */errcnt=/* no errors */eof=/* not eof yet */inp2=/* or include file */ncmp=}/* no open compound states */lastst=/* no last statement yet */quote[1]=0;/* ...all set to zero.... */kill();/}* empty input line *//* fake a quote literal */quote[0]='"';cmode=1;/* enable preprocessing */ctext=0;glbflag=1;}nxtlab=0;litlab=getlabel();/* process ALL input */parse();/* then dump literal pool */dumplits();/* and al}l static memory */dumpglbs();/* and link information */dumpnams();/* summarize errors */ersum();$)/* *Pro}cess all input text * * At this level, only static * declarations, * defines, includes, and function * definitions are l}egal.... */parse()$(/* do until no more input */while (eof==0)$(abtchk();if(amatch("extern",6))$(if(amatch("}char",4))declglb(cchar,extrn);else$(amatch("int",3);declglb(cint,extrn);$)ns();$)else if(ama}tch("char",4))$(declglb(cchar,global);ns();$)else if (amatch("int",3))$(declglb(cint,global);ns();}$)else if(match("#include"))doinclude();else if(match("#define"))addmac();else newfunc();/* force eof if p}ending */blanks();$)$)/* * Dump the literal pool */dumplits()$(int k;/* if nothing there, exit...*/if (lit}ptr==0) return;/* print literal label */outcdf(litlab);/* data for next n bytes */outdat(litptr);/* init an inde}x... */k=0;while (k");break;$)else if((c=='>' & angflag)| (c=='"' & angflag==0))break;els}e mline[mptr++]=c;$)mline[mptr]=0;normalize(mline,"H"); /* header */putchar(eol);ps("including ");ps(mline);putch}ar(eol);if((inp2=copen(mline,'r'))<0)$(inp2=0;error("Open failure on include file");$)kill();/* clear rest of }line *//* so next read will come from *//* new file (if open) */$)/* *Close the output file */clout()$(/*} if open, close it */if(output)cclose(output);output=0;/* mark as closed */$)/* check if user pressed break */abtc}hk()$(char i;if(peek(17))return;poke(17,255);i=7;while(i>0)cclose(i--);usr(dpeek(10)); /* jmp (DOS) */$)/* end} of cc1 */cg"/*>>>>> start cc1 <<<<<<*//* Compiler begins execution here * inp is input fd, * output is output fd * ; usr subroutines for small-c; on call the 6502 stack has; ; . . . ; ;; Put result in X (high) & a (low)ual= $f0uah= $f1ua= ualubl= $f2ubh= $f3ub= ublucl= }$f4uch= $f5assert *=$3003jmp ciojmp cgetcjmp cputcjmp strcpyjmp movejmp usrxjmp findjmp peekjmp poke}jmp dpeekjmp dpokejmp sound;p00p Begin usr code subr;(sp) is 2*#args+2, so put 'em on;machine stack, jsr, and subr-r}eturnP00pjsr poptopldy #0lda (t),y taxdexdexstx nargslda splsecsbc nargssta tllda sphsbc #0sta t}hjsr cusrxsta plstx phjmp p16p ;& return;# of args*2 in X;pointer to start of;arg list in tnargsdb 0cusrxl}dy nargsbeq cusrxq;push args onto stack (last first)cusrxldeydeylda (t),y ;lowphainylda (t),y ;hiphadey}bne cusrxl;all args pushed, go fer it!cusrxqlda nargslsr aphajsr getvaljmp (t);cio(i); int i; returns result }codecioplaplaplaasl aasl aasl aasl ataxplaplasta $342,x ;iccomplatayplacpy #$ffbeq cio1st}a $344,x ;icbaltyasta $345,x ;icbahcio1platayplacpy #$ffbeq cio2sta $348,x ;icblltyasta $349,x ;icblh}cio2platayplacpy #$ffbeq cio3sta $34a,x ;icax1cio3platayplacpy #$ffbeq ciodosta $34b,x ;icax2ciod}ojsr $E456tyabpl ciog;error code -- return two's complementcioeeor #$ffclcadc #1ldx #$ffrtsciogldx #0rt}s;cgetc(x)cgetcplaplaplaand #7asl aasl aasl aasl ataxlda #7 ;getcharsta $342,xlda #0sta $348,x}sta $349,xjsr $e456bmi cgetceldx #0rtscgetcetyajmp cioe;8/12/82;cputc(c,i) -- character c, iocb icputcpla}plaplatayplaplaand #7asl aasl aasl aasl ataxlda #11sta $342,xlda #0sta $348,xsta $349,xtya}jmp ciodo;strcpy(a,b) -- move chars in b to astrcpyplapla ! sta uahpla ! sta ualpla ! sta ubhpla ! sta ublldy} #0sty uchstrcpllda (ub),ysta (ua),ybeq strcpqinybne strcplinc uahinc ubhinc uchjmp strcplstrcpqtya;}return lengthldx uchrts;move(a,b,l) char *a,*b; int l;; move l chars from a to b (inc-ing)moveplapla ! sta uahpl}a ! sta ualpla ! sta ubhpla ! sta ublpla ! sta uchpla ! sta uclldy #0movellda uclbne movel1lda uchbeq mo}veq ;zerodec uchmovel1dec ucllda (ua),ysta (ub),yinybne movelinc uahinc ubhjmp movelmoveqtax ;zerorts};usrx(addr,.....) do a call of addrusrxplatay;save # argspla ! sta uahpla ! sta ualdeytyapha;decrement & re}storejmp (ua);find(addr,len,c) -- find charfindplapla ! sta uahpla ! sta ualpla ! sta ubhpla ! sta ublplapl}a ! sta uclldy #0sty uch;high of countfindllda ublbne find2lda ubhbne find3lda #$ff;return -1taxrtsf}ind3dec ubhfind2dec ubllda (ua),ycmp uclbne find4tya;return countldx uchrtsfind4inybne findlinc uch}inc uahjmp findlpeekplaplasta uahplasta ualldx #0ldy #0lda (ua),yrtspokeplaplasta uahplasta }ualldy #0lda (ua),ytaxplaplasta (ua),ytxaldx #0rtsdpeekplaplasta uahplasta ualldy #1lda (ua)},ytaxdeylda (ua),yrtsdpokeplaplasta uahplasta ualldy #0lda (ua),ysta ublinylda (ua),ysta ubh }plasta (ua),ydeyplasta (ua),yldx ubhlda ublrts;sound (voice,pitch,distortion,volume)soundbequ $d200sound }lda #3;DAMN O.S. Bugsta $d20flda #0sta $d208;cost me four hoursplaplapla;voiceand #3asl ataxplapla }sta soundb,xplaplaand #15asl aasl aasl aasl asta ualplaplaand #15ora ualinxsta soundb,xrts;e }nd of usrx sub-routinesll-c; on call the 6502 stack has; ; . . . >="))opeq(asr,lval,k);!}else if(match("&="))opeq(and,lval,k);else if(match("^="))opeq(xor,lval,k);else if(match("|="))opeq(or,lval,k);!}else if(match("="))$(if(k==0)$(needlval();return 0;$)if(lval[1])push();if(hie1(lval2))rvalue(lval2);s!}tore(lval);return 0;$)else return k;return 0;$)opeq(func,lval,k)int func;/* not legal in unix C */int *lval,k;!}$(char *ptr;int lval2[3];if(k==0)$(needlval();return;$)if(lval[1])push();rvalue(lval); /* load current val!} */push();if(hieQuest(lval2))rvalue(lval2);if(func==add | func == sub)/* check for pointer arithmatic */if(dbltest!}(lval,lval2))doublereg();/* call function */(func)(); /* not unix C (sorry) */store(lval);$)hieQuest(lval)int l!}val[];$(int k,labf,labt;k=hieOr(lval);if(match("?")==0)return k;if(k)rvalue(lval);labf=getlabel();falsejump(labf!});expression();labt=getlabel();needcol();jump(labt);outcdf(labf);expression();outcdf(labt);return 0;/* no ri!}ght value */$)hieOr(lval)int *lval;$(int lab,k,lval2[3];k=hieAnd(lval);blanks();if(streq(line+lptr,"||")==0)retu!}rn k;if(k)rvalue(lval);lab=getlabel();push();immed();outdec(0);ne();while(match("||"))$(truejump(lab);if(!}hieAnd(lval2))rvalue(lval2);push();immed();outdec(0);ne();$)outcdf(lab);return 0;$)hieAnd(lval)int *lva!}l;$(int lab,k,lval2[3];k=hie2(lval);blanks();if(streq(line+lptr,"&&")==0)return k;if(k)rvalue(lval);lab=getlabel!}();push();immed();outdec(0);ne();while(match("&&"))$(falsejump(lab);if(hie2(lval2))rvalue(lval2);push();! }immed();outdec(0);ne();$)outcdf(lab);return 0;$)hie2(lval)int lval[];$(int k,lval2[3];k=hie3(lval);b!!}lanks();if((ch()!='|')| streq(line+lptr,"||")| streq(line+lptr,"|=")) return k;if(k)rvalue(lval);while(1)$(if(!"}(streq(line+lptr,"||")==0)& (streq(line+lptr,"|=")==0))$(if(match("|"))$(push();if(hie3(lval2))rvalue(lval2!#});or();$)else return 0;$)else return 0;$)$)hie3(lval)int lval[];$(int k,lval2[3];k=hie4(lval);!$}blanks();if((ch()!='^')|streq(line+lptr,"^="))return k;if(k)rvalue(lval);while(1)$(if(streq(line+lptr,"^=")==0)!%}$(if(match("^"))$(push();if(hie4(lval2))rvalue(lval2);xor();$)else return 0;$)else return 0;!&}$)$)hie4(lval)int lval[];$(int k,lval2[3];k=hie5(lval);blanks();if((ch()!='&')| streq(line+lptr,"&="))retu!'}rn k;if(k)rvalue(lval);while(1)$(if((streq(line+lptr,"&&")==0)& (streq(line+lptr,"&=")==0))$(if(match("&"))!(}$(push();if(hie5(lval2))rvalue(lval2);and();$)else return 0;$)else return 0;$)$)hie5!)}(lval)int lval[];$(int k,lval2[3];k=hie6(lval);blanks();if((streq(line+lptr,"==")==0)&(streq(line+lptr,"!=")==0!*}))return k;if(k)rvalue(lval);while(1)$(if (match("=="))$(push();if(hie6(lval2))rvalue(lval2);eq();$)!+}else if (match("!="))$(push();if(hie6(lval2))rvalue(lval2);ne();$)else return 0;$)$)hie6(lval)int!,} lval[];$(int k,lval2[3];k=hie7(lval);blanks();if((streq(line+lptr,"<")==0)&(streq(line+lptr,">")==0)&(streq(l!-}ine+lptr,"<=")==0)&(streq(line+lptr,">=")==0))return k;if(streq(line+lptr,">>")|streq(line+lptr,"<<"))/* this i!.}ncludes "<<=" and ">>=" */return k;if(k)rvalue(lval);while(1)$(if (match("<="))$(push();if(hie7(lval2))r!/}value(lval2);if(lval[2] | lval2[2])$(ule();continue;$)le();$)else if (match(">="))$(push();!0}if(hie7(lval2))rvalue(lval2);if(lval[2] | lval2[2])$(uge();continue;$)ge();$)else if((streq!1}(line+lptr,"<"))&(streq(line+lptr,"<<")==0))$(inbyte();push();if(hie7(lval2))rvalue(lval2);if(lval[2] | l!2}val2[2])$(ult();continue;$)lt();$)else if((streq(line+lptr,">"))&(streq(line+lptr,">>")==0))!3}$(inbyte();push();if(hie7(lval2))rvalue(lval2);if(lval[2] | lval2[2])$(ugt();continue;$)gt(!4});$)else return 0;$)$)/* end of cc5 */mbol table address, * else 0 for constant * lval[1] - type of indirect 5#include "CCG"/* start of cc2 *//*Get required array size * * invoked when declared variable is * followed by "[" * t%6}his routine makes subscript the * absolute * size of the array. */needsub()$(int num[1];if(match("]"))return 0;/*%7} null size */if (number(num)==0)/* go after a number */$(error("must be constant");/* it isn't */num[0]=1;/* so f%8}orce one */$)if (num[0]<0)$(error("negative size illegal");num[0]=(-num[0]);$)needbrack("]");/* force singl%9}e dimension */return num[0];/* and return size */$)/* Begin a function * * Called from "parse" this routine * trie%:}s to make a function * out of what follows. */newfunc()$(char n[namesize],*ptr;int argtop,adr[1]; /* for usr(x) */i%;}f (symname(n)==0)$(error("illegal function or declaration");kill();/* invalidate line */return;$)if(ptr=findgl%<}b(n))/* already in symbol table ? */$(if(ptr[ident]!=function)multidef(n);/* already variable by that name */else %=}if(ptr[offset]==function)multidef(n);/* already function by that name */else ptr[offset]=function;/* otherwise we %>}have what was earlier*//* assumed to be a function */$)/* if not in table, define as a function now */else$(ad%?}dglb(n,function,cint,function,global);ptr=findglb(n); /* get offset */$)/* report we're hacking a function */p%@}utchar(28);putchar(eol);putchar(156);ps(n);/* we had better see open paren for args... */if(match("(")==0)erro%A}r("missing open paren");outldf(ptr); /* print fun name */locptr=startloc;/* pl woods */argstk=0;/* init arg count */%B}while(match(")")==0)$(/* then count args *//* any legal name bumps arg count */if(symname(n))$(if(findloc(n))mul%C}tidef(n);else$(addloc(n,0,0,argstk); /* remember name, rank */argstk=argstk+2;$)$)else$(error("illega%D}l argument name");junk();$)blanks();/* if not closing paren, should be comma */if(streq(line+lptr,")")==0)$(if(m%E}atch(",")==0)error("expected comma");$)if(endst())break;$)argtop= (-argstk); /* remember arguement offset bas%F}e */oursp=0;/* preset stack ptr */while(argstk)/* now let user declare what types of things *//*those arguments%G} were */$(if(amatch("char",4))$(getarg(cchar,argtop);ns();$)else if(amatch("int",3))$(getarg(cint,argtop);ns();$)els%H}e$(error("wrong number args");break;$)$)if(amatch("asm",3))$( /* usr(x) function */if(number(adr)==0)$(error("Nee%I}ded address");adr[0]=0;$)/* output a usr(x) byte-code */usr(adr[0]);ns();$)else if(statement()!=streturn%J}) /* do a statement, but if *//* it's a return, skip *//* cleaning up the stack */$(modstk(0);ret();$)ou%K}rsp=0;/* reset stack ptr again */locptr=startloc;/* deallocate all locals */$)/* *Declare argument types * * cal%L}led from "newfunc" this routine * adds an entry in the * local symbol table for each named * argument * re-written as per%M} pg. 32 of * Feb. '81 Dr. Dobb's Journal */getarg(t,argtop)/* t = cchar or cint */int t,argtop;$(int j,legalname,%N}address;char n[namesize],*argptr;while(1)$(if(argstk==0)return;/* no more args */if(match("*"))j=pointer;else%O} j=variable;if((legalname=symname(n)) == 0)illname();if(match("["))/* pointer ? *//* it is a pointer, so skip all *%P}//* stuff between "[]" */$(while(inbyte()!=']')if(endst())break;j=pointer;$)if(legalname)$(if(arg%Q}ptr=findloc(n))$( /* add in details */argptr[ident]=j;argptr[type]=t;address=argtop+((argptr[offset]&255)+%R}((argptr[offset+1]&255)<<8));argptr[offset]=address&255;argptr[offset+1]=((address>>8)&255);$)else error(%S}"Expecting arguement name");$)argstk=argstk-2;/* cnt down */if(endst())return;if(match(",")==0)error("expect%T}ed comma");$)$)/* * Statement parser * called whenever syntax requires * a statement. * this routine performs that *%U} statement * and returns a number telling * which one */statement() $(abtchk();if ((ch()==0) & (eof)) return;else %V}if(amatch("char",4))$(declloc(cchar);ns();$)else if(amatch("int",3))$(declloc(cint);ns();$)else if(match(%W}"$("))compound();else if(amatch("if",2))$(doif();lastst=stif;$)else if(amatch("while",5))$(dowhile('w');las%X}tst=stwhile;$)else if(amatch("do",2))$(dowhile('d');lastst=stwhile;$)else if(amatch("switch",6))$(doswitch()%Y};lastst=stswitch;$)else if(amatch("return",6))$(doreturn();ns();lastst=streturn;$)else if(amatch("break",%Z}5))$(dobreak();ns();lastst=stbreak;$)else if(amatch("continue",8))$(docont();ns();lastst=stcont;$)e%[}lse if(amatch("for",3))$(dofor();lastst=stfor;$)else if(match(";"));else$(expression();ns();lastst=stexp%\};$)return lastst;$)/* Semicolon enforcer * called whenever syntax requires * a semicolon */ns()$(if(match(";")==0)%]}error("missing semicolon");$)/*Compound statement * allow any number of statements to * fall between "$($)" */compound%^}()$(++ncmp;/* new level open */while (match("$)")==0)  if (eof)$(error("missing final end");break;$)%_} else statement(); /* do one */--ncmp;/* close current level */$)/*"if" statement */doif()$(int flev,fsp%`},flab1,flab2;/* save current local level, sp */flev=locptr;fsp=oursp;/* get label for false branch */flab1=getlabel%a}();/* get expression & branch false */test(flab1);/* if true, do a statement */statement();/* then clean up the sta%b}ck */oursp=modstk(fsp);/* and deallocate any locals */locptr=flev;if (amatch("else",4)==0)/* if...else ? *//* sim%c}ple "if"...print false label */$(outcdf(flab1);return;/* and exit */$)/* an "if...else" statement. */jump(flab%d}2=getlabel());/* jump around false code */outcdf(flab1);statement();/* and do "else" clause */oursp=modstk(fsp);/*%e} then clean up stk ptr */locptr=flev;/* and deallocate locals */outcdf(flab2);/* print true label */$)/*"while" s%f}tatement */dowhile(wtype)char wtype;$(int lwq[wqsiz];/* record local level */lwq[wqsym]=locptr;/* and stk ptr */%g}lwq[wqsp]=oursp;/* and looping label */lwq[wqloop]=getlabel();/* and exit label */lwq[wqlab]=getlabel();/* and no%q}B'DOS SYSB*+DUP SYSB'UCC7 C B2|CC8 C BMEDITMACECFB!CC3 C BCC1 C BDBCX MACB( CC5 C B@5CC2 C B~CC6 C BDBC2 MACBXDBC MACBCC LNKBCC21 C B CLINK C B *CCG H B 7CCV C BCCC0 C BKCC9 C B]CLINK2 C ByCLINK LNKB{CC4 C B CLINKD C BCLINKL C BCLINK3 C BCLINKT MACBCLINKG H BDISKNAMEDAT inc label */lwq[wqinc]=0;/* add entry to queue *//* (for "break" statement) */addwhile(lwq);/* loop label */o%r}utcdf(lwq[wqloop]);if(wtype=='w')$(/* while ... * see if true; if so, do * statement. */test(lwq[wqlab]);%s}statement();$)else$(/* do ... while * do statement first, then test. */statement();if(amatch("while",5)==0%t})error("do with no while");test(lwq[wqlab]);ns();$)jump(lwq[wqloop]);/* exit label */outcdf(lwq[wqlab]);%u}/* deallocate locals */locptr=lwq[wqsym];/* clean up stk ptr */oursp=modstk(lwq[wqsp]);/* delete queue entry */d%v}elwhile();$)/*"return" statement */doreturn()$(/* if not end of statement, get an expression */if(endst()==0)expr%w}ession();modstk(0);/* clean up stk */ret();/* and exit function */$)/*"break" statement */dobreak()$(int *pt%x}r;/* see if any "whiles" are open */if ((ptr=readwhile())==0)return;/* no *//* else clean up stk ptr * jump to ex%y}it label */modstk((ptr[wqsp]));jump(ptr[wqlab]);$)/*"continue" statement */docont()$(int *ptr;/* see if any%z} "whiles" are open */if (wq==wqptr)$(error("No active whiles");return;/* no */$)ptr=wqptr-wqsiz;/* point to tos%{} *//* find non-switch */while(ptr >= wq)$(if(ptr[wqloop])break;ptr = ptr - wqsiz;$)if(ptr < wq)$(error("No %|}active whiles");return;$)/* else clean up stk ptr * & jump to loop lable */modstk((ptr[wqsp]));if(ptr[wqinc])j%}}ump(ptr[wqinc]);else jump(ptr[wqloop]);$)/* end of cc2 */* * invoked when declared variable is * followed by "[" * t$?#include "ccg"/* start of cc6 */hie7(lval)int lval[];$(int k,lval2[3];k=hie8(lval);blanks();if(((streq(line+lpt)}r,">>")==0) &(streq(line+lptr,"<<")==0))| streq(line+lptr,"<<=")| streq(line+lptr,">>="))return k;if(k)rvalue(l)}val);while(1)$(if (match(">>"))$(push();if(hie8(lval2))rvalue(lval2);asr();$)else if(match("<<"))$()}push();if(hie8(lval2))rvalue(lval2);asl();$)else return 0;$)$)hie8(lval)int lval[];$(int k,lval2[3];)}k=hie9(lval);blanks();if((ch()!='+')&(ch()!='-'))return k;if(streq(line+lptr,"+=")|streq(line+lptr,"-="))return k;)}if(k)rvalue(lval);while(1)$(if (match("+"))$(push();if(hie9(lval2))rvalue(lval2);if(dbltest(lval,lval2)))}doublereg();if(dbltest(lval2,lval))$(swapstk();doublereg();swapstk();$)add();result(lval,lv)}al2);$)else if (match("-"))$(push();if(hie9(lval2))rvalue(lval2);if(dbltest(lval,lval2))doublereg();)}if(dbltest(lval2,lval))$(swapstk();doublereg();swapstk();$)sub();if((lval[2]==cint)&(lval2[)}2]==cint))$(push();immed();outdec(1);asr(); /* halve value */$)result(lval,lval2);$)else re)}turn 0;$)$)hie9(lval)int lval[];$(int k,lval2[3];k=hie10(lval);blanks();if((ch()!='*')&(ch()!='/')&(ch()!)}='%'))return k;if(streq(line+lptr,"*=")|streq(line+lptr,"/=")|streq(line+lptr,"%="))return k;if(k)rvalue(lval);)}while(1)$(if (match("*"))$(push();if(hie9(lval2))rvalue(lval2);mult();$)else if (match("/"))$(push())};if(hie10(lval2))rvalue(lval2);div();$)else if (match("%"))$(push();if(hie10(lval2))rvalue(lval2);m)}od();$)else return 0;$)$)hie10(lval)int lval[];$(int k;char *ptr;if(match("++"))$(if((k=hie10(lval))==)}0)$(needlval();return 0;$)if(lval[1])push();rvalue(lval);inc();if(lval[2]==cint)inc(); /* *int */s)}tore(lval);return 0;$)else if(match("--"))$(if((k=hie10(lval))==0)$(needlval();return 0;$)if(lval[1])})push();rvalue(lval);dec();if(lval[2]==cint)dec();store(lval);return 0;$)else if(match("-"))$(k=hie10(l)}val);if (k) rvalue(lval);neg();return 0;$)else if(match("$-"))$( /* tilde */k=hie10(lval);if(k)rvalue(lval)});com();return 0;$)else if(match("!"))$(k=hie10(lval);if(k)rvalue(lval);push(); /* push value */immed())};outdec(0);eq();/* compare to zero */return 0;$)else if(match("*"))$(k=hie10(lval);if(k)rvalue(lval);)}if(ptr=lval[0])lval[1]=ptr[type];else lval[1]=cint;/* flag as not pointer or array */lval[2]=0;return 1;$)els)}e if(match("&"))$(k=hie10(lval);if(k==0)$(error("illegal address");return 0;$)ptr=lval[0];lval[2]=ptr[)}type];if(lval[1])return 0;/* global & non-array */immed();outlab(ptr);lval[1]=ptr[type];return 0;$)else)}$(/* check for postfix */k=hie11(lval);if(match("++"))$(if(k==0)$(needlval();return 0;$)if(lval)}[1])push();rvalue(lval);inc();if(lval[2]==cint)inc();store(lval);dec();if(lval[2]==cint)dec();ret)}urn 0;$)else if(match("--"))$(if(k==0)$(needlval();return 0;$)if(lval[1])push();rvalue(lval)});dec();if(lval[2]==cint)dec();store(lval);inc();if(lval[2]==cint)inc();return 0;$)else return)} k;$)$)/* end of cc6 *//hie7(lval)int lval[];$(int k,lval2[3];k=hie8(lval);blanks();if(((streq(line+lpt( ; subr for multiplyACC = $E0 ; BASIC USR RTNMQ = $E2 ; MLTPLIER/QUOTENT = $E4 ; MCAND/DIVSORSC = $E6 ; SIGN CO-}NTROL;; ENTER WITH A,Y=DIVISOR (A=MSB); ACC,MQ=DIVIDEND;; UNSIGNED DIVIDE OF 32/16 BITS;; EXIT WITH ACC=REMAINDER;-} MQ=QUOTIENT;UDIV STA ENT+1 STY ENT; BELOW IS "SIDE DOOR" ENTRY FOR; SIGNED DIVIDE ROUTINEUDSD LDY #16UDLP ASL MQ-} ROL MQ+1 ROL ACC ROL ACC+1; HAVING SHIFTED ACC,MQ LEFT BY; ONE BIT, WE CHECK FOR THE CASE; WHERE ACC=1XXXX ( INCL. CAR-}RY).; IF FOUND, WE SKIP TRIAL SUBTRACT; ELSE WE TRY TO SUB ENT FROM ACC. BCC UDL0 LDA ACC SBC ENT LDA ACC+1 SBC ENT+1-} JMP UDSQUDL0 LDA ACC CMP ENT LDA ACC+1 SBC ENT+1; THIS DOES A "TRIAL SUBTRACT"; IF CARRY IS SET THEN WE SHOULD; RE-}ALLY SUBTRACT. IF NOT, WE; SHOULD JUST SHIFT. BCC UDL1 STA ACC+1 ; STORE MSB LDA ACC SBC ENT ; RE-DO LSB STA ACCUDS-}Q INC MQ ; SET QUOT BITUDL1 DEY ; COUNT BITS BNE UDLP RTS;;; ENTER WITH A,Y=DIVISOR (A=MSB); ACC=DIVIDEND; SIG-}NED DIVIDE OF 16/16 BITS;; EXIT WITH ACC=REMAINDER; MQ=QUOTIENT;SDIV LDX #0 ; CONSTANT STA ENT+1 STY ENT CMP #$80 -} ; SET C IF A- EOR ACC+1 STA SC ; SAVE SIGN BCC SDL1 ; IF ENT>-1,SKIP TXA ; ELSE ENT=0-ENT SBC ENT STA ENT-} TXA SBC ENT+1 STA ENT+1SDL1 LDY ACC LDA ACC+1 CMP #$80 ROR SC ; SAVE SIGN;; SC HOLDS TWO FLAGS; D7=1 MEANS ACC WA-}S MINUS, SO WE; SHOULD NEGATE THE REMAINDER;; D6=1 MEANS THE NUMBERS WERE OF; OPPOSITE SIGN, SO WE SHOULD; NEGATE THE QU-}OTIENT BPL SDL3 ; ACC+,SKIP TXA ; ELSE NEGATE SEC SBC ACC TAY TXA SBC ACC+1SDL3 STA MQ+1 STY MQ STX ACC -} ; CLEAR MSW STX ACC+1 JSR UDSD; ENTER UNSIGNED DIV BY SIDE DOOR;; WHEN WE RETURN, WE MUST CORRECT; THE SIGNS OF QUOTI-}ENT AND REM. BIT SC BPL SDCQ; IF ACC WAS +, WE LEAVE REM +.; ELSE WE MUST NEGATE IT TXA ; X=0, SO ACC=0 SEC SBC AC-}C STA ACC TXA SBC ACC+1 STA ACC+1SDCQ BIT SC BVC SDXT; IF SIGNS WERE THE SAME, WE; LEAVE QUOT. ALONE,; ELSE WE MUS-}T NEGATE IT. TXA SEC SBC MQ STA MQ TXA SBC MQ+1 STA MQ+1SDXT RTS; ENTER WITH MQ=MULTPLIER; ACC=MULTIPLICAND; 16-}*16 SIGNED MULTIPLY;; EXIT WITH ACC,MQ=PRODUCT; ACC=MSWSMULlda mq+1;SAVE MPLR MSBEOR ACC+1STA SC ;SAVE SIGN-}S;If MPLR is MINUS, we DECREMENT; to form its 1'S COMPLEMENT,lda mq+1;GET MPLRBMI SMLM;else we COMPLEMENT it.EO-}R #$FFSTA MQ+1lda mqEOR #$FFSTA MQJMP SMCASMLMlda mqBNE SML0dec mq+1SML0dec mq;now check sign of accSM-}CALDA ACC+1 ; CK SIGN OF ACCbpl smda; -, complement acclda #0SECSBC ACCSTA ENTlda #0SBC ACC+1STA ENT+1j-}mp smdm; +,copy as-issmdasta ent+1lda accsta entSMDMlda #0sta accsta acc+1;Now MQ= 1's comp MULTIPLIER;ENT-}=MULTIPLICAND;ACC=0;(ACC,MQ)=(MQ*ENT)LDY #16;SHIFT OUT FIRST BIT OF MPLIERLSR MQ+1ROR MQ;IF C IS ONE IT WAS ZER-}O,;IN WHICH CASE WE SHOULD JUST;SHIFT.UMLPBCS UML4LDA ACCADC ENT ;carry clear, natch.STA ACCLDA ACC+1ADC ENT+-}1STA ACC+1UML4LSR ACC+1ROR ACCROR MQ+1ROR MQ;gets next carry bitDEY;16 loops.BNE UMLP;On return we negate -}PRODUCT;if SC is MINUS.;( That is if we had DIFFERENT; signs on INPUT )BIT SC ; CK SIGN CNTLBPL SMXT ; EXIT IF LIKE-};mq = - mqseclda #0SBC MQSTA MQlda #0SBC MQ+1STA MQ+1SMXTRTS;end of math routines.SC = $E6 ; SIGN CO,h;c-code interpreter for;Atari 400/800 deep-blue-c compiler;(C) 1982 John Howard Palevichrevnum= 1;revision # of c-code1}debug= 0;nz if debuggingPCL= $D0 ;c-code prog countPCH= $D1PC= PCLSPL= $D2;c-code stack-pointSPH= $D3SP= SPL1}PL= $D4;primary registerPH= $D5P= PLTL= $D8TH= $D9T= TLmemtop= $2e5eol= $9b;atascii end-of-lineendint=1} $3c00;end of c-code interpbegtok= $4000 ;start of c-code;here begins the c-code interpreterorg $3000jmp beg ;for r1}andom reasonsinclude D:DBCX.MACheadmsdb 'dbc',revnumif debugcmsgdb 125,'dbc engine revision 'db $30+revnum,eol1}db '(C) 1982 John H Palevich',eoldb 'Select trace mode:',eoldb '0 - no trace',eoldb '1 - screen',eoldb '3 - screen, 1}printer',eoldb '-> 'clen= *-cmsgtflgdb 0 ;nz if we should tracepflgdb 0 ;nz if we should printprnamdb 'P:',1551}ednamdb 'E:',155edio= $70ciov= $e456endif;first check if we have a c-code file;of the right vintage (same u-code re1}v)begldx #3beglplda begtok,xcmp headms,xbne badrevdexbpl beglpjmp goodrv;alas, wrong version of c-codebadr1}evlda #'C' ;bad c codejmp errorgoodrvif debugldx #ediolda #3sta $342,xlda #low ednamsta $344,xlda #high e1}dnamsta $345,xlda #12sta $34a,xjsr ciovldx #ediolda #11;putchrsta $342,xlda #high cmsgsta $345,xlda #lo1}w cmsgsta $344,xlda #high clensta $349,xlda #low clensta $348,xjsr ciov;get key from luser;-- 0 - no scr or pr1}inter;-- 1 - just screen;-- 3 - screen & printerldx #ediolda #7 ;getchrsta $342,xlda #0sta $348,xsta $349,xj1}sr ciovphacinlpjsr ciovcmp #eolbne cinlpplaphaand #1sta tflgplaand #2sta pflglda pflgbeq beg21}ldx #$10lda #3sta $342,xlda #high prnamsta $345,xlda #low prnamsta $344,xlda #8sta $34a,xjsr ciovendif1};set up dummy call of main()beg2lda #low ccstubsta pcllda #high ccstubsta pch;set up stack pointerlda begtok+71}sta spllda begtok+8sta sphjmp next ;and away we go!;C-CODE stub (call main, jump to exit;get addr of main (at begt1}ok+5);push,call tos (0 args),call exitccstubdb 2dw begtok+5db 12,17,2 ;no argsdb 15dw enditdb 2;no args.endi1}tdb 0;usr(x)dw endit2endit2jmp ($a) ;return to DOS; next -- dispatch on next opnext:if debuglda tflgbne nex1}t2 ;trace mode?endifLDY #0LDA (PC),YINC PCLBNE nextrINC PCHnextr:if debugjmp next3;tracenext2LDA #'#1}'jsr putcclda pchjsr putbylda pcljsr putbyjsr putslda #'p'jsr putcclda phjsr putbylda pljsr putbyj1}sr putslda #'s'jsr putccldy #1lda (sp),yjsr putbyldy #0lda (sp),yjsr putbyjsr putslda #'j'jsr putcc1}lda sphjsr putbylda spljsr putbyjsr putsJSR FPCphalda #'='jsr putccplaphajsr putbyjsr putsplan1}ext3CMP #47 ;highest used op-codebcc nextoklda #'B'JMP ERRORnextok:endifASL A ;*2TAY ;no more than 128 op-cod1}esLDA JUMPT,YSTA TLLDA JUMPT+1,YSTA THif debuglda tflgbeq nextgotyaasl a ;*4tayldx #3nextpolda opc1}ode,yjsr putcinydexbpl nextpolda #155jsr putcendifnextgoJMP (T) ;dispatchif debug;table of opcode mne1}monics (4 chars ea)opcodedb 'usrxlpb lpw j+# 'db 'spb spw ljpbljpw'db 'lppblppwpXs lp# 'db 'pushjnz pXj call'db 'r1}et calsjumpjz 'db 'j+-#p*2 s+p s-p 'db 's*p s/p s%p s|p 'db 's!|ps&p s>>ps<p s>=pS

P S>=Pcmpj';debugging print routinesputcxdb 0putcydb 0putcstx putcxsty putcy1}ldx #ediophalda #11sta $342,xlda #0sta $348,xsta $349,xplaphajsr ciovlda pflgbeq putcqldx #$10l1}da #11sta $342,xlda #0sta $348,xsta $349,xplajsr ciovjmp putcqqputcqplaputcqqldx putcxldy putcyrts;p1}ut spaceputslda #' 'jmp putc;put char then colonputccjsr putclda #':'jmp putc;put hex byte in aputbyphalsr 1}a ! lsr a ! lsr a ! lsr ajsr puthcplaand #$fputhccmp #$abcs puthc1clcadc #'0'jmp putcputhc1clcadc #'a'-$1}ajmp putcendif ;debug; fpc -- postinc fetch from pcFPC LDY #0 LDA (PC),Y INC PCL BNE FPCR INC PCHFPCR RTS; ju1}mpt jump tableJUMPTDW p00p,P01P,P02P,P03PDW P04P,P05P,P06P,P07PDW P08P,P09P,P10P,P11PDW P12P,P13P,P14P,P15PDW P16P1},P17P,P18P,P19PDW P20P,P21P,P22P,P23PDW P24P,P25P,P26P,P27PDW P28P,P29P,P30P,P31PDW P32P,P33P,P34P,P35PDW P36P,P37P1},P38P,P39PDW P40P,P41P,P42P,P43PDW P44P,P45P,p46p; error -- display error code in Aerrormdb 155,'dbc ',$30+revnumd1}b ' run-time-error "',27errorcdb 0,'"',155,'Type a key to return to DOS.',155errorl= *-errormERRORsta errorcldx #01}lda #11 ;putchrsta $342,xlda #low errormsta $344,xlda #high errormsta $345,xlda #low errorlsta $348,xlda #hig1}h errorlsta $349,xjsr $e456lda #255sta 764errorw cmp 764beq errorwsta 764JMP ($A) ;Return to DOS II; p01p1} load byte to PP01P JSR GETVAL LDY #0 LDA (T),Y STA PL TYA STA PH JMP NEXT;; getval - get 2 bytes & inc pcGETVAL L1}DY #0 LDA (PC),Y STA TL INY LDA (PC),Y STA TH LDA PCL CLC ADC #2 STA PCL BCC GETVAR INC PCHGETVAR RTS;; p02p ge1}t word to PP02P JSR GETVAL LDY #0 LDA (T),Y STA PL INY LDA (T),Y STA PH JMP NEXT;; p03p -- SP+# -> PP03PJSR GETVA1}Llda splclcadc tlsta plLDA sphadc thSTA PHJMP NEXT;; p04p -- P -> (#) charP04P JSR GETVAL LDY #0 LDA PL1} STA (T),Y JMP NEXT; p05p -- P -> (#) wordP05P JSR GETVAL LDY #0 LDA PL STA (T),Y INY LDA PH STA (T),Y JMP NEXT;1} p06p -- P -> (tos) char SP--P06PJSR POPTOPLDY #0LDA PLSTA (T),Y; popnex decrement spPOPNEXLDA SPLsecsbc #21}STA SPLlda sphsbc #0sta sphPOPNE1jmp next; put tos into tPOPTOPLDY #0LDA (SP),YSTA TLINYLDA (SP),YSTA1} THRTS; p07p Store wd P -> (TOS) SP--P07P JSR POPTOP LDY #0 LDA PL STA (T),Y INY LDA PH STA (T),Y JMP POPNEX; 1}p08p (P) -> P byteP08P LDY #0 LDA (P),Y STA PL STY PH JMP NEXT;; p09p (P) -> P wordP09PLDY #0LDA (P),Y TAX INY1} LDA (P),Y STA PH STX PL JMP NEXT;; p10p swap P and SP10Plda #'B'jmp error; P11p load P immedP11P JSR GETVAL LD1}A TL STA PL LDA TH STA PH JMP NEXT; p12p push P onto stackP12Pjsr pushspLDY #0LDA PLSTA (SP),YINYLDA PHST1}A (SP),YJMP NEXT; pushsp double inc spPUSHSPlda splclcadc #2STA SPLlda sphadc #0sta sphcmp memtop+1bcc1} pushsrbne pushsolda splcmp memtopbcs pushsopushsrRTSpushsolda #'A'jmp error; p14p Swap P and TOSP14P LDY 1}#0 LDX PL LDA (SP),Y STA PL TXA STA (SP),Y INY LDX PH LDA (SP),Y STA PH TXA STA (SP),Y JMP NEXT; p15p -- call i1}mmP15P JSR PUSHSP JSR GETVAL LDA PCL LDY #0 STA (SP),Y INY LDA PCH STA (SP),Y LDA TL STA PCL LDA TH STA PCH JMP 1}NEXT; p16p -- return (and adjust stack)P16PLDY #0LDA (SP),YSTA PCLINYLDA (SP),YSTA PCHjsr fpc ;# of args * 21}+2sta tllda splsecsbc tlsta spllda sphsbc #0sta sphjmp next; p17p -- call tosP17P LDY #0 LDX PCL LDA 1}(SP),Y STA PCL TXA STA (SP),Y INY LDX PCH LDA (SP),Y STA PCH TXA STA (SP),Y JMP NEXT;; p18p -- jumpP18P JSR GETV1}AL LDA TL STA PCL LDA TH STA PCH JMP NEXT;; test & jnzerop13plda plora phbne p18pjmp p19w;; p19p -- test & 1}jzeroP19PLDA PLORA PHBEQ P18P;skip addressp19wLDA #2CLCADC PCLSTA PCLBCC P19RINC PCHP19RJMP NEXT;; com1}pare to constant & jump equalp46pjsr getvallda plcmp tlbne p19wlda phcmp thbne p19wjmp p18p;;p20p -- sp+# -1}> spP20PJSR GETVALlda splclcadc tlsta spllda sphadc thsta sphcmp memtop+1bcc p20pqbne p20pelda spl1}cmp memtopbcc p20pqp20pelda #'A' ;overflow RAMjmp errorp20pqjmp next; p21p -- double PP21PASL PLROL PHJMP 1}NEXT; p22p -- P <- S+PP22Pldy #0LDA (sp),yCLCADC PLSTA PLinyLDA (sp),yADC PHSTA PHJMP popnex;; p23p -1}- P <- S-PP23Pldy #0lda (sp),ySECSBC PLSTA PLinylda (sp),ySBC PHSTA PHJMP popnex;; p24p -- P <- S * PP1}24PLDA PLSTA ACCLDA PHSTA ACC+1ldy #0lda (sp),ysta mqinylda (sp),ysta mq+1JSR SMULLDA MQSTA PLLDA 1}MQ+1STA PHJMP popnex;; p25p -- P <- S / PP25PJSR DIVLDA MQSTA PLLDA MQ+1STA PHJMP popnex;; p26p -- P <- S1} % PP26PJSR DIVLDA ACCSTA plLDA ACC+1STA phjmp popnex;; mq <- S / P, acc <- S % PDIVldy #0lda (sp),ySTA A1}CCinyLDA (sp),ySTA ACC+1lda phora plbne div1lda #'D'jmp errordiv1lda phldy PLjmp SDIV; p27p P <- S o1}r PP27P ldy #0LDA (sp),yORA PLSTA PLinyLDA (sp),yORA PHSTA PHjmp popnex;; p28p P <- S xor PP28Pldy #01}LDA (sp),yEOR PLSTA PLinyLDA (sp),yEOR PHSTA PHJMP popnex; p29p P <- S and PP29Pldy #0LDA (sp),yAND PL1}STA PLinyLDA (sp),yAND PHSTA PHJMP popnex;; p30p P <- S asr PP30PLDX PLcpx #8beq p30pf;normal shiftl1}dy #0LDA (sp),ySTA PLinyLDA (sp),ySTA PHCPX #0BEQ P30QP30LLSR PHROR PLDEXBNE P30LP30QJMP popNEX;p 1}<- s >> 8p30pfldy #0sty phinylda (sp),ysta pljmp popnex;;; p31p P <- S asl PP31PLDX PLcpx #8beq p31pf2};normal shiftldy #0LDA (sp),y STA PLinyLDA (sp),ySTA PHCPX #0BEQ P31QP31LASL PLROL PHDEXBNE P31LP312}Qjmp popnex; p <- s << 8p31pfldy #0sty pllda (sp),ysta phjmp popnex; p32p 2's complement PP32PLDA #0SECS2}BC PLSTA PLLDA #0SBC PHSTA PHJMP NEXT;; p33p 1's complement PP33PLDA #$FFEOR PLSTA PLLDA #$FFEOR PHST2}A PHJMP NEXT; p34p inc PP34PINC PLbne P34QINC PHP34QJMP NEXT; p35p dec PP35PLDA PLBNE P35P1DEC PHP35P12}DEC PLJMP NEXT; subtract S from P to PSUBldy #0SECLDA (sp),ySBC PLSTA PLinyLDA (sp),ySBC PHSTA PHRT2}S;; p36p S == P ?P36Pjsr sublda plora phBNE FALSE;; true -- 1 -> PTRUELDX #1STX PLDEXSTX PHJMP popNEX;2}; p37p S != P ?P37Pjsr sublda plora phBNE TRUE;; false -- 0 -> PFALSELDA #0STA PLSTA PHJMP popNEXT; p38p2} S < PP38PJSR SUBLDA PHBMI TRUEBPL FALSE; p39p S <= PP39PJSR SUBLDA PHBMI TRUEBNE FALSELDA PLBNE FALSE2}BEQ TRUE; p40p S > PP40PJSR SUBLDA PHBMI FALSEBNE TRUELDA PLBNE TRUEBEQ FALSE; p41p S >= PP41PJSR SUBL2 }DA PHBMI FALSEBPL TRUE; p42p Unsigned S < PP42Pldy #1LDA (sp),yCMP PHBCC TRUEBNE FALSEdeyLDA (sp),yCMP 2 }PLBCC TRUEBCS FALSE;; p43p Unsigned S <= PP43Pldy #1lda (sp),yCMP PHBCC TRUEBNE FALSEdeylda (sp),yCMP P2 }LBCC TRUEBEQ TRUEBNE FALSE;; p44p Us S > PP44Pldy #1lda (sp),yCMP PHBCC FALSEBNE TRUE2deylda (sp),yCM2 }P PLBCC FALSEBEQ FALSETRUE2JMP TRUE; p45p S >= PP45Pldy #1lda (sp),yCMP PHBCC FALSEBNE TRUE2deylda (sp2 }),yCMP PLBCS TRUE2FALSE2JMP FALSE;end of c-code routinesinclude D:DBC2.MACassert *<=endintEND BEGf c-code0tCCV.CCCCC0.CCCCC1.CCCCC2.CCCCC21.CCCCC3.CCCCC4.CCCCC5.CCCCC6.CCCCC7.CCCCC8.CCCCC9.CCCAIO.CCCDBC.OBJGf c-code4q#include "ccg"/* deep blue c compiler * switch and for processors */doswitch()$(int sq[wqsiz]; /* like while */int:} label;/* lable for case */int dlabel;/* for default */int nlabel; /* for next case */int val;/* case value */char:} xflag; /* another case seen */char defflag; /* 'default' seen */dlabel=defflag=xflag=0; /* init */sq[wqsym]=locptr;:}sq[wqsp]=oursp;sq[wqlab]=getlabel(); /* get exit *//* tell docont() we're a switch */sq[wqloop]=0;addwhile(sq);ne:}edbrack("(");expression();needbrack(")");/* result of expr is in P */needbrack("$(");if(!(defflag=amatch("default",:}7))&& !amatch("case",4))error("'case' or 'default' expected");do$(label=getlabel();do$(if(defflag)dlabe:}l=label;else$(if(number(&val)==0 &&pstr(&val)==0)error("constant needed");cmpjump(val,label);$):}needcol();$) while((defflag=amatch("default",7))|| amatch("case",4));nlabel=getlabel();jump(nlabel);:}outcdf(label);do statement();while(!(defflag=amatch("default",7))&& !(xflag=amatch("case",4))&& !(match(":}$)")));jump(nlabel+1); /* fall thru */outcdf(nlabel);$) while (xflag || defflag);/* end of case */if(dlabel)jump:}(dlabel);outcdf(nlabel+1);outcdf(sq[wqlab]);locptr=sq[wqsym];oursp=modstk(sq[wqsp]);delwhile();$)/* "for" statem:}ent */dofor()$(int fq[wqsiz];fq[wqsym]=locptr;fq[wqsp]=oursp;fq[wqloop]=getlabel();fq[wqlab]=getlabel();fq[wq:}inc]=getlabel();fq[wqstat]=getlabel();addwhile(fq);needbrack("(");if(match(";")==0)$( /* exp1 */expression();ns:}();$)outcdf(fq[wqloop]);if(match(";")==0)$( /* exp2 */expression();ns();falsejump(fq[wqlab]);$)jump(fq[wqs:}tat]);outcdf(fq[wqinc]);if(match(")")==0)$( /* exp3 */expression();needbrack(")");$)jump(fq[wqloop]);outcdf(f:}q[wqstat]);statement();jump(fq[wqinc]);outcdf(fq[wqlab]);locptr=fq[wqsym];oursp=modstk(fq[wqsp]);delwhile();$):}needcol()$(if(match(":")==0)error("Missing colon");$)/* end of cc21 */ch()$(int sq[wqsiz]; /* like while */int8P/* * Deep Blue C Linker v 1.2 * (C) 1982 John Howard Palevich */#include "clinkg"charstab[stsize],buf[block],type[>!}maxsym],eof;intslink[maxsym],vtab[vtsize], *vbp,vbase[maxf],ctab[ctsize], *cbp,cbase[maxf],sptr,fptr,bptr,ba>"}d,input,output,errcnt,pc;main()$(pl("\fDeep Blue C linker v1.2");pl("(C) 1982 John Howard Palevich");while(co>#}mmand())putchar('\g');$)/* get command line & respond to the * three types of command -- * link, duplicate, quit */co>$}mmand()$(char inline[80],c;int foff;pl("\nLink program, Duplicate file or Quit");gets(inline);if((c=inline[0])<='Z'>%})c=c+32;if(c=='q')return 0; /* quit */if(c!='d' & c!='l')$(ps("'");putchar(c);pl("' is not a valid command.">&});return 1; /* loop */$)if((foff=find(inline,find(inline,80,0),' '))<0)$(pl("file name?");gets(inline);fo>'}ff=0;$)else ++foff; /* skip space */if(c=='l')$( /* link */normalize(inline+foff,"LNK");link(inline+foff);$)>(}else if(c=='d')$( /* duplicate */normalize(inline+foff,"CCC");duplicate(inline+foff);$)return 1; /* get another >)}command */$)e C Linker v 1.2 * (C) 1982 John Howard Palevich */#include "clinkg"charstab[stsize],buf[block],type[</* DBC header file v 1.1 *(C) 1982 J H PALEVICH */#define NULL 0#define eol 155#define tabchar 127#definesymsiz14#deB+}finesymtbsz4998#define numglbs 300#definestartglb symtab#defineendglbstartglb+numglbs*symsiz#definestartloc endglb+B,}symsiz#defineendlocsymtab+symtbsz-symsiz#definename0#defineident9#definetype10#definestorage11#defineoffsetB-}12#definenamesize 9#define namemax 8#definevariable 1#definearray2#definepointer3#definefunction 4#definecchaB.}r1#definecint2#defineglobal1#definestkloc2#define extrn3#definewqtabsz100#definewqsiz6#definewqmaxwq+wqtB/}absz-wqsiz#definewqsym0#definewqsp1#definewqloop2#definewqlab3#definewqinc4#definewqstat5#definelitabsz3B0}000#definelitmaxlitabsz-1#definelinesize 200#definelinemaxlinesize-1#definempmaxlinemax#definemacqsize 800#defiB1}nemacmaxmacqsize-1#definestif1#definestwhile2#definestreturn 3#definestbreak4#definestcont5#definestasm6#B2}definestexp7#definestfor8#definestswitch9extern charsymtab[symtbsz];extern char*glbptr,*locptr;extern intwq[wqtB3}absz];extern int*wqptr;extern charlitq[litabsz];extern intlitptr;extern charmacq[macqsize];extern intmacptr;externB4} charline[linesize];extern charmline[linesize];extern intlptr,mptr;extern intnxtlab,litlab,oursp,argstk,ncmp,B5}errcnt,eof,inp,output,inp2,glbflag,ctext,cmode,lastst;extern charquote[2];extern char*cptr;extern int*B6}iptr;extern char c;/* end of global file for cc */define NULL 0#define eol 155#define tabchar 127#definesymsiz14#de@6#include "CCG"/* Deep Blue C compiler v. 1.1 * (C)1982 John Howard Palevich * define global variables *//* symbol tablF8}e */charsymtab[symtbsz];/* ptrs to next entries */char*glbptr,*locptr;charfname[20];/* file name */intwq[wqtabsz]F9};/* while queue */int*wqptr;/* ptr to next entry *//* literal pool */charlitq[litabsz];/* ptr to next entry */intF:}litptr;/* macro string buffer */charmacq[macqsize];/* and its index */intmacptr;/* parsing buffer */charline[linesF;}ize];/* temp macro buffer */charmline[linesize];/* ptrs into each */intlptr,mptr;/*Misc storage*/intnxtlab,/* F<}next avail label # *//* label # assigned to literal pool */litlab,/* compiler relative stk ptr */oursp,argstk,/* fuF=}nction arg sp *//* # open compound statements */ncmp,/* # errors in compilation */errcnt,/* set non-zero on final inpuF>}t eof */eof,inp,/* iob # for input file *//* iob # for output file (if any) */output,/* iob # for "include" file */F?}inp2,/* non-zero if internal globals */glbflag,/* non-zero to intermix c-source */ctext,/* non-zero while parsing c-F@}code *//* zero when passing assembly code */cmode,/* last executed statement type */lastst;/* literal string for '"' FA}*/charquote[2];/* work ptr to any char buffer */char*cptr;/* work ptr to any int buffer */int*iptr;/* general purposFB}e character var */char c;/* End of CCV */ * (C)1982 John Howard Palevich * define global variables *//* symbol tablD.#include "CCG"/* * Top level of Deep Blue C compiler * (C) 1982 John H. Palevich */main()$(char fbase[20],fin[20],fouJD}t[20];int i,j;ps("\fDeep Blue C Compiler ");ps(" version 1.2");pl("(C)1982 John Howard Palevich");while(1)$(i=1;JE} /* close any open files */while(i<=7)cclose(i++);putchar(eol);pl("File to compile ");ps("(or RETURN to exit)");JF}putchar(eol);gets(fbase);if(fbase[0]==0)return; /* exit */normalize(fbase,"C");strcpy(fin,fbase);strcpy(fouJG}t,fbase);i=find(fin,20,0); /* length+1*/j=find(fin,i,'.'); /* extension */strcpy(fout+j,".CCC");ps(fin);ps("-JH}>");ps(fout);putchar(eol);if((inp=copen(fin,'r'))<0)$(pl("Couldn't open:");ps(fin);continue;$)JI}if((output=copen(fout,'w'))<0)$(pl("Couldn't open:");ps(fout);continue;$)compile();cclose(fout);cJJ}close(fin);putchar(253); /* beep bell */$)$)openout()$($)openin()$(if(eof)inp=0;$)char fbase[20],fin[20],fouHb#include "ccg"/* cc9 *//* *Declare a static variable * (i.e. define for use) * * makes an entry in the symbol * taNL}ble so subsequent * references can call symbol by name * * typ is cchar or cint * sclass = extern or global */declglbNM}(typ,sclass)int typ,sclass;$(int k,j;char sname[namesize];char *ptr;/* ptr to sym table entry to** check extern*/NN}while(1)$(while(1)$(if(endst())return;/* do line */k=1;/* assume 1 element */if(match("*"))/* pointer ? */NO}j=pointer;/* yes */else j=variable; /* no */if(symname(sname)==0) /* name ok? */illname(); /* no... */NP}if(ptr=findglb(sname))/* already there?*/if(ptr[storage]==extrn&& sclass != extrn)ptr[storage]=global;NQ}else if(sclass != extrn)multidef();if(match("["))$(/* array? */k=needsub();/* get size */if(k)j=array;NR}/* !0=array */else$(j=pointer; /* 0=ptr */k=2;$)$)addglb(sname,j,typ,k,sclass); /* add symbol NS}*/break;$)if(match(",")==0)return; /* more? */$)$)/*** Declare local variables** (i.e. define for use)*NT}*** works just like "declglb" but** modifies machine stack** and adds symbol table entry with** appropriate** stack offsNU}et to find it again*/declloc(typ)/* typ is cchar or cint */int typ;$(int k,j;char sname[namesize];while(1)$(wNV}hile(1)$(if(endst())return;if(match("*"))j=pointer;else j=variable;if (symname(sname)==0)illname()NW};if(findloc(sname))multidef(sname);if (match("["))$(k=needsub();if(k)$(j=array;if(typ==cinNX}t)k=k+k;$)else$(j=pointer;k=2;$)$)elseif((typ==cchar)&(j!=pointer))k=1NY};else k=2;/* change machine stack (stack points to TOS) */addloc(sname,j,typ,oursp+2);oursp=modstk(oursp+k);bNZ}reak;$)if (match(",")==0) return;$)$)/* dump names of globals */dumpnams()$(char code;cptr=startglb;whN[}ile(cptr 0)$(putchar(c);if(c==eol)$(if(j==0)continue; /*blank line*/else breakRa};$)else s[j++]=c;$)if(j)$(s[j]=0;if(s[0]==';') /* comment */continue;normalize(s,"CCC");reRb}turn 1;$)else return 0;$)$)pass1()$(char c,buf[BSIZE],*b,*e;int i;/* no cc0 & cc1 is for string lits */cbp[Rc}0]=cbp[1]=1; /* read in file */if(bgetchr(buf,BSIZE,&i))return;b=buf;e=buf+i;while(b=gmin)vbp[i-gmin]=pc;else cbp[i]=pc;b+=2;break;case lglb:case lexRg}t:i=b[0]+(b[1]<<8)-gmin;b+=2;b+=1+strcpy(stab+sptr*symsiz,b);slink[sptr]=vbp-vtab+i;/* link will index ofRh}f ofvtab, not vbp! */if(c==lglb)type[sptr]=global;else$(type[sptr]=external;vbp[i]=i+1; /* marRi}k as used (no ldef) */$)if(++sptr>maxsym)error("Too many globals\n");break;default:error("bad byte coRj}de.\n");break;$)$)if(b!=e)error("bad CCC file\n");$)/* Get the whole file at once * (return non-zero if error)Rk} */bgetchr(buf,max,len)char *buf;int max,*len;$(int i;if((i=ciov(input,7,buf,max,-1,-1))>0)$(error("CCC file tRl}oo large\n");return 1;$)else if(i!=-136)$(ioerror("can't read file",".CCC file",i);return 1;$)else$(*Rm}len=dpeek(0x348+(input<<4));return 0;$)$)error(s)char *s;$(ps("error ");ps(s);++errcnt;$)ioerror(kind,name,vaRn}l)char *kind,*name;int val;$(++errcnt;printf("[%s]%s:%d\n",name,kind,-val);$)flush()$(int i;if(bptr==0)$(bad=Ro}pc;return;$)pad(bad);pad(bad+bptr-1);i=0;while(bptr--)pby(buf[i++]);bad=pc;bptr=0;$)pad(a)int a;$(pby(a &Rp} 255);pby((a >> 8) & 255);$)pby(b)char b;$(cputc(b,output);$)ws(s)char *s;$(while(*s)wb(*s++);$)wa(a)iRq}nt a;$(wb(a & 255);wb((a >> 8) & 255);$)wb(b)char b;$(buf[bptr]=b;++pc;if(++bptr >= block)flush();$)pass2Rr}()$(char c,buf[BSIZE],*b,*e;int i,lbase;lbase=cbp[1]; /* cc1 */if(bgetchr(buf,BSIZE,&i))return;b=buf;e=buf+i;whRs}ile(b 0)wb(*b++);break;case dspc:pc+=b[0]+(b[1]<<8);b+=2;flush();Rw}break;case lglb:case lext:b+=find(b+2,BSIZE,0)+3;break;default:error("bad op code\n");break;$Rx})$)if(b!=e)error("bad CCC code\n");$)#define luse 128#define ldef 129#define bcon 130#define wcon 131#define rdatP+;This is the link file for clink v1.2CLINKCLINK2CLINK3CLINKDCLINKL;I/O LibraryAIOPRINTF;Table look up routineCLINKTVz}.OBJ;Abstract C Machine InterpreterDBC.OBJLINK2CLINK3CLINKDCLINKL;I/O LibraryAIOPRINTF;Table look up routineCLINKTT-#include "CCG"/* start of cc4 */keepch(c)char c;$(mline[mptr]=c;if(mptr=mpmax)error("line too long");lptr=0Z};mptr=strcpy(line,mline)+2;$)addmac()$(char sname[namesize];int k;if(symname(sname)==0)$(illname();kill();Z}return;$)k=0;while(putmac(sname[k++]));while (ch()==' ' | ch()==tabchar)gch();while(putmac(gch()));if(macptrZ}>=macmax)error("macro table full");$)putmac(c)char c;$(macq[macptr]=c;if(macptr=0)$(pl("File too big, use DOS");cclose(fin);return;$)if(i!=-136)$(ioerror("read^} error",fname,i);cclose(fin);return;$)/* get # of bytes read */j=dpeek(0x348+(fin<<4));cclose(fin);pl("Insert^} destination disk & type RETURN");gets(buf); /* dummy input */if((fout=copen(fname,'w'))<0)$(ioerror("Can't write",fn^}ame,fout);return;$)j=ciov(fout,11,stab,j,-1,-1);cclose(fout);if(j<0)ioerror("write error",fname,j);else pl("D^}uplicated successfully");$)/* * fcopy(in,out) -- copy all bytes in * in to out */fcopy(fin,fout)int fin,fout;$(cha^}r c;int i,j;i=ciov(fin,7,stab,stsize,-1,-1);if(i>=0)pl("File too big. Sorry");else if(i!=-136)ioerror("Read err^}or",".OBJ file",i);else$(/* get # of bytes read */j=dpeek(0x348+(fin<<4));j=ciov(fout,11,stab,j,-1,-1);if(j^}<0)ioerror("Write error",".OBJ file",j);$)$)/* duplicate(fname) -- read file into * buffer, let user swap disk,\8/* link files according to flist */#include "clinkg"link(flist)char *flist;$(int files,sporg,mainv,i,j;char fnameb}[cifn],fout[cifn];errcnt=sptr=fptr=i=0;while(flist[i]!=0 & flist[i]!='.')++i;strcpy(fout,flist);strcpy(fout+i,".COb}M");printf("%s->%s\n",flist,fout);pc=begtok+9;clear(vtab,vtsize);clear(ctab,ctsize);clear(stab,stsize);clear(tyb}pe,maxsym);clear(slink,maxsym);if((files=copen(flist,'r'))<0)$(ioerror("can't find",flist,files);return;$)if((b}output=copen(fout,'w'))<0)$(ioerror("can't write ",fout,output);cclose(files);return;$)vbp=vtab;cbp=ctab;b}while(errcnt==0& gfname(fname,files))$(if((input=copen(fname,'r'))<0)$(ioerror("can't find",fname,input);b}break;$)eof=0;/* check file type */if((j=find(fname,20,'.'))<0)error("unknown file type");/* skip binary fb}iles this pass */else if(streq(fname+j,".OBJ"));else if(streq(fname+j,".CCC"))$(pass1();++fptr;/* look for b}free space */while(*vbp++);vbase[fptr] = --vbp;/* look for free space */while(*cbp++);cbase[fptr] = --cbpb};$)else error("unknown file type");cclose(input);$)cclose(files);if(errcnt)$(cclose(output);return;$)b}printf("Statistics:\n%d\tSymbols\n",vbp-vtab);printf("%d\tLabels\n",cbp-ctab);printf("%d\tGlobals\n",sptr);printf("b}Code starts $%x\n",begtok);printf("Stack starts $%x\n",pc);pl("linking. . .");resolve();if(errcnt)$(cclose(outb}put);return;$)pl("pass 2");if((files=copen(flist,'r'))<0)$(ioerror("Can't re-read",flist,files);cclose(outb}put);return;$)sporg=pc;pc=bad=begtok;bptr=fptr=0;if((mainv=lookup("main")) < 0)$(error("No main()\n");cclob}se(files);cclose(output);return;$)pby(0xff);pby(0xff);ws("dbc");wb(revnum);wb(0);wa(vtab[slink[mainv]]);b}wa(sporg);vbp=vtab;cbp=ctab;while(errcnt==0& gfname(fname,files))$(if((input=copen(fname,'r'))<0)$(ioerror(b}"can't re-open file",fname,input);break;$)eof=0;/* check file type */if((j=find(fname,20,'.'))<0)erb}ror("unknown file type");/* copy binary files this pass */else if(streq(fname+j,".OBJ"))fcopy(input,output);elb}se if(streq(fname+j,".CCC"))$(pass2();flush();++fptr;vbp=vbase[fptr];cbp=cbase[fptr];$)else error(b}"unknown file type");cclose(input);$)cclose(files);cclose(output);if(errcnt==0)pl("no errors");return;$) fname`w/* * table look-up for linker v 1.2 */#include "clinkg"resolve()$(int i,j,k,m;char *addr,used;for(i=0;i=0)vtab[slink[i]]=vtab[slink[k]];else$(errf}or("never defined:");pl(j);$)$)$)$)/* look for global n */lookup(n)char *n;$(int i,j;for(i=0;i